perm filename NOTWRT.F4[XX,LCS]7 blob
sn#199918 filedate 1976-02-04 generic text, type T, neo UTF8
00010 C********** FOR NOTE DRAWING, RESTS ACCENT AND OTHER MARKS.
00100 SUBROUTINE NOTWRT
00200 IMPLICIT INTEGER(A-Q,S-Z)
00300 COMMON/DL/IXRX,M,AA /FONT/JFONT
00400 COMMON/SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
00600 COMMON/DAT/RACNT(65),RDOT(17),XAC(7),RNOTE(22),RACCI(22),NACCI(3)
00700 REAL DIS,CENTR,POS,STFF
00800 COMMON /STF/RSTFAC(-3/4),RSTJ2
00900 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
01000 COMMON/PLTR/PLT,RHT,DIS /POSI/STFF(-3/4),JJ2,POS
01110 C ITEMS IN FOLLOWING COMMON BLOCK ARE USED IN 'TAILS' AND 'FERM'
01200 COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
01300 1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,J5X,RXX,JJJ,
01400 1 PUNCT,RDIS,RJ
01500 EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R4,RJQ(2))
01600 1,(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
01700 1,(J11,JQ(9)),(J6,JQ(4)),(R5,RJQ(3)),(R11,RJQ(9))
01800 1,(R8,RJQ(6)),(R7,RJQ(5)),(RX,JRX),(RJZ,RJQ(20)),(R3,RJQ(1))
01900 DATA RACNT/4.0,1000.005,17.0,0.105, 8.0,1003.0, 7.014, 11.0
02000 1,13. ,1000. ,0.010,14.01,14. ,17. ,1001.018,7. ,13.018,27.,
02100 1 1004., 4.002, 6.004, 8.004,10.002,10., 8.102,6.102,4.
02200 1,32.0,1000.0,14.0,1007.007,7.107, 43.0,1012.01,11.006,9.003
02300 1, 7.001, 5.0, 9.002, 13.006, 15.01, 10.004, 13.009, 52.0,
02400 1 1002.008,3.003, 5.001, 8.0, 10.0, 13.001, 15.003, 16.008,
02500 1 65.,1106.104, 0.002, 6.104, 12.002, 18.104, 24.002, 24.003,
02600 1 18.103, 12.003, 6.103, 0.003, 106.103/
02700 1 ,RNOTE/ 1000., 5.007, 11.007, 16., 11.107, 5.107, 0.0,
02800 1 1000.0, 7.007, 14.0, 7.107, 0, 1000.107, 14.007,
02900 1 1014.107,0.007, 1000.003,4.107,6.007,9.107,11.007,14.103/
03000 DATA RDOT/1000.101, .102, 1.103, 2.103, 3.102, 3.101, 2., 1.,
03050 1 .101, 2.103, 2., .102, 3.102, 1., 1.103, 3.101, .102/
03100 1 , R5/5.0/, R66/66.0/, R72/72.0/,R18/18.0/,RSTM/14.54/
03200 1 ,XAC/9,14,18,28,33,44,53/
03300 C ALL DATA NUMS OVER 90 GIVE INVISIBLE VECTORS
03400 DATA RACCI/6.0,1115.003, 110.007, 106.001,
03500 1 115.109, 115.021, 15.0, 1104.104, 118.108,
03600 1 1108.113, 108.016, 1104.008, 118.004,
03700 1 1114.014, 114.115, 22.0,1106.117, 106.007, 114.004
03800 1, 1114.018, 114.107, 106.104/
03900 1 ,NACCI/1,7,16/
04000
04100 RST7=7.*RSTJ2
04200 RST3=3.*RSTJ2
04300 RSTX=RSTJ2
04400 C FOR MINIS AT 245
04500 RMINI=RSTJ2
04600 C OR SHOULD THIS ONLY BE IN NOTES, ETC? 15/9/72
04700
04800 RINV=1
04900 IF(JA.EQ.1)GO TO 11
05000 IF(JA.EQ.9)GO TO 242
05100
05200 C NEXT IS FOR RESTS
05210 IF(IABS(J4).LT.400)GO TO 302
05220 C P4+500= EARLY MUSIC RESTS
05230 CALL EARLY
05240 RETURN
05300 302 IF(R8.NE.0)J5=-2
05400 C R8 PUTS NUMBER OVER WHOLE REST ONLY.
05500 IF(J5.GT.1)R4=R4-2
05600 CC RA=R4
05700 R7=R6*10.
05800 C FOR DOTS
05900 202 CALL REST
06000 IF(J5.GT.1)GO TO 200
06100 IF(R7.EQ.0)RETURN
06200 201 RA=14
06300 R6=0
06400 IF(J5)RA=19
06500 R3=R3+RA*RSTJ2
06600 R4=8.+R4
06700 JA=9
06800 J5=7
06900 C IF P6=1 THE REST IS DOTTED
07000 CALL CENTX
07100 GO TO 242
07200 200 J5=J5-1
07300 C FOR MULTIPLE TAILS ON 16TH REST, ETC.
07400 R4=R4+2.
07500 CALL RJBX(4.3)
07600 GO TO 202
07700
07800 29 RJX=R3
07900 RJY=CENTR+RSTJ2
08000 108 IF(WHOLE.NE.0)RJX=RJX+3.*RMINI
08100 C WHOLE=1 MEANS IT'S A WHOLE NOTE (WIDER THAN A HALF.)
08200 WHOLE=0
08210 RG=9
08220 IF(PLT)RG=17
08230 C DOESN'T FILL DOT ON DPY
08300 107 CALL RDRAW(1,RG,RDOT,RMINI,RJX,RJY,RMINI)
08400 C **** **** *** ↑↑↑↑↑↑↑↑↑↑ THESE WERE RSTJ2 11/74
08500 IF(JA.EQ.1)GO TO 290
08600 IF(R7.GE.20.)GO TO 290
08700 RB=POS+52.*RSTJ2
08800 IF(RJY.NE.RB)GO TO 6241
08900 C WHERE IS RB USED LATER?
09000 RJY=RJY-12*RSTJ2
09100 GO TO 107
09200 C ABOVE FOR DOTS
09300 290 R7=R7-10.
09400 IF(R7.LT.10.)GO TO 1342
09500 RJX=RJX+RSTJ2*10.
09600 GO TO 107
09700
09800 GO TO 1121
09900
10000 C NOTES****
10100 11 JY=0
10200 IF(R6.EQ.0)GO TO 1015
10300 JY=IABS(J6)
10400 R6=ABS(AMOD(R6,1.0))*10.
10500 C R6 WILL HAVE ACCENT CODE # (.7=DOT, ETC.)
10600 1015 L=IABS(J4)
10700 RJAC=R3
10800 C TO SAVE POS. OF NOTE FOR ACCENT
10900 RZTM=2.*RSTJ2
11000 STEM=J5/10
11100 1010 IF(L.LT.100)GO TO 1013
11200 IF(L.LT.200)GO TO 1012
11300 RZTM=0
11400 IF(L.GE.300)GO TO 1014
11500 KL=8
11600 RG=12.0
11700 C FOR DIAMOND NOTES.
11800 GO TO 1013
11900 1014 IF(L.GE.400)GO TO 1016
12000 RJX=RMINI*7
12100 C FOR "X" NOTES.
12200 KL=13
12300 RG=16.
12400 RB=CENTR+RJX
12500 IF(STEM.EQ.2)RB=CENTR-RJX
12510 GO TO 1013
12610 1016 IF(L.LT.1000.OR.L.GE.10000)GO TO 1011
12620 KL=-1
12630 IF(L.LT.2000)KL=-KL
12640 C PUTS NOTE ON STAFF ABOVE(2000) OR BELOW(1000)-NEXT FIND POS ON OTHER STAFF
12650 RB=(STFF(J2-KL)-STFF(J2))/RST7
12660 R4=R4+RB
12662 CALL CENTX
12664 C STEM WILL GO TO EQUIV. SPOT ON "HOME" STAFF. USE NEG P8 TO ADJUST
12666 IF(R8.EQ.999)R8=0
12667 RZ=ABS(RB)
12669 C (((OR MOVE STUFF FROM 128 UP TO 11)))
12670 IF(KL.AND.J5.GE.20)RZ=-RZ
12672 IF(KL.GT.0.AND.J5.LT.20)RZ=-RZ
12674 R8=R8-RZ
12680 CALL CENTX
12682 C RESET BASIC VERT. POS. (BASED ON P4. AMOD IS DONE IN CENTX)
12684 L=MOD(L,1000)
12686 J9=-1
12690 C SUPRESSES LEDGER LINES
12695 GO TO 1010
12700 1011 IF(L.LT.10000)GO TO 1019
12750 GO TO 1013
12760
12800 1019 IF(L.GE.500)GO TO 1017
12850 RB=CENTR+R11*RST7
12900 C +400 FOR NO NOTE HEAD. P11 CAN ADJUST SOURCE OF STEM.
13000 GO TO 1013
13010 1017 RG=R4
13032 CALL EARLY
13033 C THE EARLY MUSIC PACKAGE. +500
13080 RETURN
13100
13200 1012 RMINI=.6*RSTJ2
13300 C FOR RMINI NOTES
13400 CC** DONE IN CENTX *** 1017 R4=AMOD(R4,100.)
13500 C FOR MINI TAILS AND ACCIS. ETC.
13600 1013 J4=R4
13700 RJZ=R4
13800 C RJZ FOR FLAT, #, NAT. RX4 FOR TR., HARM, ETC.
13900 RX4=R4
14000 IF(JY.LT.10)GO TO 2221
14100 IF(JY.GE.30)GO TO 2221
14200 C P6 FOR HOMING TO RIGHT(10,30) OR LEFT(20) OF STEM(10,30=UP, 20=DOWN)
14300 C P6<0 = WHITE NOTE
14400 RQ=RSTM
14500 IF(J6)RQ=RQ+1.66
14600 C GETS WIDTH OF NOTE DISPLACEMENT
14700 IF(JY.EQ.20)RQ=-RQ
14800 R3=R3+RQ*RMINI
14900 2221 IF(J4.LE.1)GO TO 322
15000 IF(J4.LT.13)GO TO 1121
15100
15200 322 IF(J9)GO TO 1121
15300 C ARE THERE LEDGER LINES? P9=-1 SUPPRESSES THEM.
15400 J11=(J4+1)/2-6
15500 IF(J11)J11=-((3-J4)/2)
15600
15700 C FOR LEDGER LINES
15800 RJW=R3-7.*RMINI
15900 RZ=R3+20.*RMINI
16000 IF(J11)GO TO 71
16100 JX=J11
16200 JRX=13
16300 C********* 18/9/72
16400 GO TO 711
16500 71 JX=-J11
16600 JRX=J11*2+3
16700 711 RX=POS-18*RSTJ2+RST7*JRX
16800 C********* 18/9/72
16900 IF(J6)RZ=RZ+2*RMINI
17000 C126 IF(PLT.EQ.-3)GO TO 1126
17100 C FOR 2-PASS PLOTTING
17200 C ******* ABOVE IS NOT USED, 15/9/72
17300 126 CALL LINX(RJW,RX,RZ,RX)
17400 IF(PLT.NE.-2)GO TO 1126
17500 RJY=RX-1./RHT
17600 CALL LINX(RJW,RJY,RZ,RJY)
17700 1126 IF(JX.EQ.1)GO TO 1122
17800 RX=RX+RSTJ2*14.
17900 JX=JX-1
18000 GO TO 126
18100 1122 J9=-1
18200
18300 C IF J6≠0 NOTE IS FILLED IN
18400 1121 IF(L.GE.400)GO TO 123
18500 C JUMP IF NO NOTE HEAD
18600 IF(J6)GO TO 1322
18700 IF(L.LT.200)GO TO 125
18800 1322 IF(L.GE.200)GO TO 1253
18900 C FOR DIAMOND AND X NOTES.
19000 KL=1
19100 RG=7.
19200 C FOR WHITE NOTES ON DPY.
19300 WHOLE=MOD(J7,10)
19400 IF(WHOLE.EQ.0)GO TO 2122
19500 STEM=0
19600 C FOR VARIOUS AUTOMATIC FEATURES IN 'SCORE' SECTION.
19700 J7=0
19800 R5=AMOD(R5,10.)
19900 J5=R5
19910 IF(PLT)GO TO 2121
19920 IF(WHOLE.NE.2)GO TO 1253
19922 RQ=POS-18.*RSTJ2+RST7*(R4-1.)
19925 CALL LINX(R3,RQ,R3,RQ+RST7+RST7)
19930 C PUT IN LINE TO SHOW DBL WHOLE ON SCREEN (P7=2)
20000 2122 IF(PLT.GE.0)GO TO 1253
20100 2121 IF(L.GE.200)GO TO 1253
20200 J5=15+WHOLE
20300 C IF WHOLE=1, THEN WHOLE NOTE SHAPE INSTEAD OF HALF. (P7=1)
20400 RG=RSTJ2
20500 C FIX THIS SOME DAY↓↓ SEE 1342+1!
20600 CCXX IF(RMINI.NE.RSTJ2)RSTJ2=.7*RSTJ2
20700 C THESE NOTES ARE IN CLEF1. 1/2=13 WHOLE=14
20800 JX4=J4
20900 RQ=R7
21000 C SAVE IT FOR DOTS
21100 CALL DRWNT
21200 R7=RQ
21300 J4=JX4
21400 C GET IT BACK
21500 RSTJ2=RG
21600 C DRAWS GOOD NOTES ON PLOTTER -- NOT ON DPY.
21700 CC DONE IN DRWNT R7=J7
21800 C TO RESET IT.
21900 GO TO 123
22000 1251 CALL NOIR(RMINI)
22100 C FOR QUARTER NOTES ON PLOTTER.
22200 GO TO 123
22300
22400 125 IF(PLT)GO TO 1251
22500 KL=17
22600 RG=22.
22700 C ABOVE IS NEW NOTES ROUTINE
22800 1253 CALL RDRAW(KL,RG,RNOTE,RMINI,R3,CENTR,RMINI)
22900 IF(PLT.GE.0)GO TO 123
23000 IF(KL.EQ.8)GO TO 2253
23100 IF(KL.NE.13)GO TO 123
23200 C MAKE DBL THICK X AND DIAMOND NOTES
23300 2253 RH=R3-1.0
23400 CALL RDRAW(KL,RG,RNOTE,RMINI,RH,CENTR,RMINI)
23500
23600 123 R5=R5-J5
23700 C R5=STEPS TO LEFT FOR ACCID. (.1=1 STEP)
23800 IF(STEM.EQ.0)GO TO 1242
23900 IF(L.LT.300)RB=CENTR+RZTM
24000 C************↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑ +2
24100 C ≥300 IS FOR 'X' NOTES.
24200 128 J7=MOD(J7,10)
24300 RG=(J7-1)*14
24400 IF(RG)RG=0
24500 CC IF(R8.EQ.999)R8=0
24600 C 999 IS STANDARD (0) STEM LENGTH.
24700 IF(R8.NE.999)GO TO 1751
24800 R8=0
24900 RH=0
25000 GO TO 2751
25100 1751 IF(R8.LT.999)GO TO 751
25200 R8=R8-1000.
25300 J10=1
25400 C 1000+ PUTS SLASH ON NOTE STEM
25500 751 RH=R8*RST7
25600 C STEM EXTENSIONS ARE BY NOTE #S
25700 2751 IF(STEM.NE.2)GO TO 1280
25800 RJX=R3
25900 C FOR STEM DOWN (=2)
26000 RG=-RG-48.
26100 RH=-RH
26200 L=20
26300 RB=RB-RZTM*2
26400 C FOR TILT OF ORDINARY NOTES (NOT X OR DIAMOND)
26500 C************↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑ SEE 21800 12/74
26600 GO TO 129
26700 C NEXT IS FOR STEM UP.
26800 1280 RJX=RSTM
26900 IF(J6.EQ.0)GO TO 2322
27000 IF(J6.NE.30)RJX=16.2
27100 C FOR HALF NOTES
27200 2322 RJX=RJX*RMINI+R3
27300 RG=RG+48.
27400 L=10
27500 129 RZ=CENTR+RH+RG*RMINI
27600 IF(RMINI.NE.RSTJ2)RJW=RJW*.6
27700 CALL LINX(RJX,RB,RJX,RZ)
27800 C RB HERE IS CENTR (FOR 'X' NOTES OR NOT)
27900 227 J5=J5-L
28000 C J5 HAS ACCID. # NOW
28100 IF(J7.LE.0)GO TO 1242
28200 C JUMP IF NO TAILS
28300 RJW=2.*RMINI/RSTJ2
28400 C FOR VERT. SPACING OF MULTIPLE TAILS
28500 IF(STEM.NE.2)GO TO 1127
28600 R4=R4-3.7-R8
28700 C R4 IS USED IN SUBR. TAIL - R8 IS STEM EXTENSION.
28800 RJW=-RJW
28900 RA=1.
29000 GO TO 127
29100 1127 R4=R4-2+R8
29200 C 2 ABOVE AND 3.7 BEFORE ARE BECAUSE ORIG. POS. OF TAIL DRWING IS OFF.
29300 RA=-1.
29400 R8=0
29500 C ↑↑↑↑↑↑ FOR SHIFT AT 246
29600 127 CALL TAIL
29700 1028 J7=J7-1
29800 IF(J7.EQ.0)GO TO 327
29900 R4=R4+RJW
30000 C MOVES CENTR UP OR DOWN FOR NEXT TAIL
30100 GO TO 127
30200 327 IF(R4.GE.RX4)RX4=R4+1
30300 CC327 IF(R4.GE.RJZ)RJZ=R4+1
30400 C FOR TRILLS, ETC.
30500 IF(J10.EQ.0)GO TO 1242
30600 RJY=RZ-19*RSTJ2
30700 RZ=RZ-RSTJ2*4.
30800 IF(RA.LT.0)GO TO 1327
30900 C NEXT IS FOR STEM DOWN SLASH
31000 RJY=RZ+23*RSTJ2
31100 RZ=RZ+RST7
31200 1327 RJX=RJX-RST7
31300 CALL LINX(RJX,RJY,RJX+17.*RSTJ2,RZ)
31400 C FOR SLASH ON GRACE NOTE TAIL
31500 1242 IF(R7.LT.10.)GO TO 1342
31600 C FOR DOTTED NOTE-- P7>9
31700 RJX=RJAC+(22.+AMOD(R7,1.0)*59.6)*RMINI
31800 C***↑↑↑↑↑ WAS 24. 11/74
31900 RJY=CENTR+RSTJ2
32000 IF(JY.EQ.10)GO TO 4322
32100 IF(JY.NE.30)GO TO 3322
32200 4322 RJX=RJX+RSTM
32300 C MOVES DOT TO LEFT
32400 3322 IF(MOD(J4,2).EQ.0)GO TO 108
32500 RX=RST7
32600 IF(JY.GE.20)RX=-RX
32700 3342 RJY=RJY+RX
32800 GO TO 108
32900 C JY=30= STEM UP, INTERVAL OF SECOND.
33000 1342 IF(J5.NE.0)GO TO 5322
33100 IF(R6.EQ.0)RETURN
33200 5322 R3=R3-R5*59.6*RMINI
33300 C TO SPACE OUT ACCIDS.
33400 CCXX IF(RMINI.NE.RSTJ2)RSTJ2=.7*RSTJ2
33500 C ↑↑↑↑ ↑↑↑↑↑ WAS RMINI
33600 C********* 18/9/72
33700 242 IF(J5.GE.0)GO TO 2421
33800 RINV=-RINV
33900 J5=-J5
34000 C NOW THAT 0 IS NOT USED FOR DOTS THE ABOVE 3 LINES COULD BE CHNGD
34100 C********** LAST # WAS 281?
34200 C b,#,NAT, ACC ∧, ACC >, FERMATA, DOT, REP MEAS., DASH
34300 CXX 11/74 2421 RH=14
34400 2421 J5X=-1
34500 JAX=JA
34600 C USED AT 4241 FOR DOUBLE MARKS ON NOTES.
34700 IF(JA.EQ.9)GO TO 2423
34800 IF(J5.GT.3)GO TO 3121
34900 C DBL FLT(4) AND DBL SHRP(5) ALWAYS USE 'DRAW' ROUTINE.
35000 GO TO 211
35100 CC2423 RJZ=AMOD(R4,100.)
35150 2423 RJZ=R4
35200 C FOR 'DRWNT' WHEN PLOTTING.
35300 CALL NOZERO(R6)
35400 C R6=SIZE FACTOR (P6)
35500 RMINI=RMINI*R6
35600 R6=0
35700 STEM=0
35800 C FOR MISC. ITEMS
35900 210 IF(IABS(J4).LT.100)GO TO 1241
36000 CC210 IF(IABS(J4).LT.100)GO TO 3241
36100 J4=MOD(J4,100)
36200 RMINI=.7*RMINI
36300 CC3421 J5X=-1
36400 C FOR 2 MARKS AT ONCE.
36500 1241 IF(J5.GE.11)GO TO 28
36600 GO TO (211,211,211,28,28,222,249,60,27,27),J5
36700 RETURN
36800 C ERROR TRAP (I.E. J5=0)
36900 C FOR 1 OR 2 BAR REP SIGNS.
37000 60 CALL BREP
37100 RETURN
37200
37300 241 CALL LINES(R3,CENTR,3)
37400 GO TO 210
37500
37600
37700 211 IF(J5.EQ.0)GO TO 2422
37800 C GETS BACK GOOD VERTICAL POS.
37900 IF(J5.GT.3)GO TO 222
38000 C FOR 2-PASS PLOTTING (-2=THIN LINES, -3=HEAVY LINES)
38100 IF(PLT)GO TO 3121
38200 IF(JFONT.NE.0)GO TO 3121
38300 X=NACCI(J5)
38400 CALL RDRAW(X+1,RACCI(X),RACCI,RMINI,R3,CENTR,RMINI)
38500 2422 IF(R6.EQ.0)RETURN
38600 J5=(R6+.001)*100.
38700 R4=RX4
38800 CC R4=RJZ
38900 R3=RJAC
39000 1249 IF(MOD(J5,10).GT.3)GO TO 249
39100 J5=J5/10
39200 IF(J5.GT.30)GO TO 1249
39300 C WHEN P1=1, EXTRACTS ACCENT NUMBERS FROM DECIMALS IN P6.
39400 249 IF(J5.GT.30)GO TO 28
39500 IF(J5.GT.10)GO TO 246
39600 IF(J5.EQ.0)RETURN
39700 IF(JA.NE.1)GO TO 250
39800 CXX 11/74 RH=8
39900 RB=14.
40000 IF(MOD(J4,2).EQ.0)GO TO 244
40100 IF(J5.EQ.7)GO TO 6322
40200 IF(J5.NE.9)GO TO 244
40300 6322 IF(STEM.GT.1)GO TO 7322
40400 IF(J4.LT.5)GO TO 244
40500 7322 IF(J4.LE.9)GO TO 8322
40600 IF(STEM.EQ.2)GO TO 244
40700 IF(STEM.EQ.0)GO TO 244
40800 8322 RB=21
40900 C PUTS ACCENT DOWN OR UP 1 SPACE. AVOIDS PUTTING DOT OR DASH ON LINE
41000 244 IF(STEM.EQ.1)GO TO 9322
41100 IF(STEM.NE.0)GO TO 245
41200 IF(J4.GE.7)GO TO 245
41300 9322 RB=-RB
41400 CC IF(J5.NE.6)GO TO 245
41500 CC IF(J4.LT.9.AND.STEM.EQ.2)GO TO 281
41600 CC IF(J4.GT.4.AND.STEM.EQ.1)GO TO 252
41700 245 CENTR=CENTR+RB*RSTX
41800 250 IF(J5.GT.10)GO TO 281
41900 IF(J5.LT.6)GO TO 281
42000 JA=9
42100 IF(J5.NE.7)GO TO 253
42200 C 7=DOT
42300 RXX=R3
42400 R3=R3+6.7*RMINI
42500 C CENTERS THE DOT
42600 GO TO 29
42700 253 IF(J5.EQ.9)GO TO 271
42800 C 9=DASH
42900 251 IF(RB.LT.0)RINV=-RINV
43000 C FIX THIS!!!! FOR BOWINGS, ETC.
43100 2222 IF(J5.NE.20)GO TO 2223
43200 CZZZZZZZZZZZ
43300 JA=7
43400 R5=0
43500 J7=1
43600 CALL ALPHA
43700 C FOR TRILL -- J5=20
43800 RETURN
43900 2223 IF(J5.EQ.17)GO TO 323
44000 IF(J5.NE.18)GO TO 222
44100 323 RINV=J5
44200 C FOR MORD, INV.MORD
44300 222 CALL FERMTA
44400 GO TO 5241
44500 252 RX=POS
44600 248 CENTR=RX
44700 GO TO 251
44800 246 IF(J5.LT.10)GO TO 245
44900 CC R4=R4+3
45000 CC IF(STEM.EQ.1)R4=R4+6.+R8
45020 RZ=3
45040 IF(STEM.EQ.1)RZ=9+R8
45060 R4=R4+RZ*RMINI/RSTJ2
45100 IF(R4.LT.12.5)R4=12.5
45200 CALL CENTX
45300 IF(J5.EQ.26)GO TO 222
45400 C 26 IS NEW NUMB FOR FERMATA.
45500 28 IF(J5.LT.30)GO TO 281
45600 J5X=MOD(J5,10)
45700 C J5X SAVES NEXT MARK.
45800 IF(J5X.LT.4)J5X=0
45900 J5=J5/10
46000 IF(J5.GT.30)RETURN
46100 C WON'T READ 415 ETC. (CORRECT=154)
46200 C DOES BOTTOM MARK FIRST, THEN TOP.
46300 CALL EXCH(J5X,J5)
46400 C PUTS UPBOW, DNBOW, ETC. ABOVE STACC., ETC.
46500 IF(JA.EQ.1)GO TO 249
46600 GO TO 1241
46700 281 X=1
46800 IF(J5.GT.16)GO TO 2222
46900 C JUMP FOR MORD, INV.MORD, TRILL
47000 IF(J5.NE.4)GO TO 228
47100 X=5
47200 CALL RJBX(.5)
47300 GO TO 328
47400 228 IF(J5.GT.10)X=XAC(J5-10)
47500 C X IS POINTER IN RACNT ARRAY
47600 328 RA=RMINI
47700 C OR RSTJ2?
47800 IF(RINV.LT.0)GO TO 1323
47900 IF(STEM.NE.1)GO TO 2323
48000 IF(J5.NE.4)GO TO 2323
48100 1323 RA=-RA
48200 C ↓↓↓ X ↓↓↓ PICKS UP TYPO ERRORS
48300 2323 IF(X.LT.54)CALL RDRAW(X+1,RACNT(X),RACNT,RA,R3,CENTR,RMINI)
48400 C PTR, WDCNT, ARRAY,Y MULT,HOR ADD,VERT ADD, X,Y,MULT
48500 C IN ARRAY, 33.012 WOULD BE X=33, Y=12. 101.123 IS X=-1, Y=-23.
48600 GO TO 5241
48700 4241 JJJ=J5
48800 J5=J5X
48900 J5X=-1
49000 IF(JAX.NE.1)GO TO 7241
49100 IF(J5.GT.10)GO TO 246
49200 IF(J5.NE.7)GO TO 7241
49300 IF(JJJ.NE.9)GO TO 249
49400 7241 RXX=8.5*RMINI
49500 C↑↑↑↑↑↑ 11/74 WAS RH*
49600 IF(STEM.EQ.1)RXX=-RXX
49700 CENTR=CENTR+RXX
49800 IF(J5.EQ.26)J5=6
49900 C TEMPORARY?? FIX
50000 GO TO 1241
50100 C >=5, ∧=4
50200 27 R3=J3
50300 C DASHES
50400 271 CALL LINX(R3,CENTR,R3+RMINI*14.,CENTR)
50500 C **** **** *** ↑↑↑↑↑↑↑↑↑↑ THIS WAS RSTJ2 11/74
50600 5241 IF(J5X.GT.0)GO TO 4241
50700 C J5X IS FOR DOUBLE MARKS. (WHAT ABOUT DOT POSITION.)
50800 RETURN
50900 6241 R3=RXX
51000 C RESET R3 AFTER A DOT.
51100 GO TO 5241
51200 3121 J5=J5+9
51300 C SOON WILL HAVE DBL FLAT (4) AND DBL SHRP (5)
51400 C TO DRAW GOOD ACCIS ON PLOTTER - NOT ON DPY.(IN CLEF4.DMD)
51500 CALL DRWNT
51600 GO TO 2422
51700 END